; (load "acl82express/code/aserve.fasl")
(load "..\\b-day.cl")
(in-package :net.aserve)
(start :port 8033)


(defun rrequest (name req)
  (cdr (assoc name (request-query req) :test #'equal))
  )

(defun int-request (name req)
  (let* (
         ( r (rrequest name req))
         ( x (parse-integer r :junk-allowed t))
         ( xx (if x x 0))
         )
    xx
    ))

(defmacro test-html (&rest body)
  `(with-output-to-string  (*html-stream*) ,@body)
  )


(defmacro w-select-option-with-selected (text-value comment)
  `(html ((:option value ,text-value :selected "selected") (:princ-safe ,comment))))

  
(defmacro w-select-option-sans-selected (text-value comment)
  `(html ((:option value ,text-value) (:princ-safe ,comment))))


(defun w-select-option (current-value numeric-value text-value comment)
  (if (equal current-value numeric-value)
      (w-select-option-with-selected text-value comment)
    (w-select-option-sans-selected text-value comment)
    ))


(defun submit-button ()
  (html  :p ((:input :type "submit" :value "submit" ) )  )
  )

(defun w-print-description (n)
  (mapcar #'(lambda (it) (html (:td (:princ-safe it)))) n))

(defun w-print-descriptions (n)
  (mapcar #'(lambda (it) (html (:tr (w-print-description it)))) n))



-
(defmacro mmake-generic-html-sequence ( internal the-list)
  `(mapcar #'(lambda (it) (html (,internal (:princ-safe it)))) ,the-list))

(defmacro make-generic-html-sequence ( external internal the-list)
  `(html ( ,external (mmake-generic-html-sequence ,internal ,the-list ))))

(defun make-uo-list (x)
  (make-generic-html-sequence :ul :li x))


(defun mmake-unordered-list (x)
  (mapcar #'(lambda (it) (html (:li (:princ-safe it)))) x))

(defun make-unordered-list (x)
  (html ( :ul (mmake-unordered-list x))))
  

(defun make-table-cell (x &key bold)
  (if (listp x) (html :td (make-uo-list x))
    (if bold (html (:td (:b (:princ-safe x))))
    (html (:td (:princ-safe x))))
    ))
      


(defun make-row (the-list &key bold)
  (mapcar #'(lambda (it) (make-table-cell it :bold bold)) the-list))
  ; (mapcar #'(lambda (it) (html (:td (:princ-safe it)))) the-list))

(defun mmake-table (the-llist )
  (mapcar #'(lambda (it) (html :tr (make-row it))) the-llist))

(defun make-table (the-llist )
  (html ((:table :bgcolor "white" :bordercolor "black" :border "1" :cellpadding "1" :cellspacing "1")
         (make-row (car the-llist) :bold t)
        (mmake-table (cdr the-llist)))))


(defmacro generic-link (page text) `(:li ((:a :href ,page) ,text) :br))
      
  
(defun select-complexity (current-value)
  (html 
   ((:select name "m-complexity")
    (w-select-option current-value 1 "1" "science project")
    (w-select-option current-value 2 "2" "new module creation")
    (w-select-option current-value 3 "3" "multiple lines in multiple modules")
    (w-select-option current-value 4 "4" "multiple lines in single module")
    (w-select-option current-value 5 "5" "one liner")
    )))


(defun ask-survey-question (the-name)
  (html (:princ-safe the-name)
         ( (:input type "radio" name "question" value (format nil "( ~a . 1 )" the-name)) "yes")
         ( (:input type "radio" name "question" value (format nil "( ~a . 0 )" the-name)) "no")
        ))

(defmacro ask-checkbox (the-name the-value &optional checked)
  `(if ,checked (html ( (:input type "checkbox" name ,the-name value ,the-value checked "checked") ,the-name ))
     (html ( (:input type "checkbox" name ,the-name value ,the-value ) ,the-name ))
     ))


(defparameter 
    *questions* 
  '(enthusiastic
    daring
    diplomatic
    satisfied
    cautious
    determined
    convincing
    good-natured
    friendly
    accurate
    outspoken
    calm
    talkative
    controlled
    conventional
    decisive
    advenrurous
    insightful
    outgoing
    moderate
    gentle
    persuasive
    humble
    original
    expressive
    conscientous
    dominant
    responsive
    poised
    observant
    modest
    impatient
    tactful
    agreeable
    magnetic
    insistent
    brave
    inspiring
    submissive
    timid
    reserved
    obliging
    strong-willed
    cheerful
    stimulating
    kind
    perceptive
    independent
    competitivive
    considerate
    joyful
    private
    fussy
    obedient
    firm
    playful
    attractive
    introspective
    stubborn
    predictable
    logical
    bold
    loyal
    charming
    sociable
    patient
    self-reliant
    soft-spoken
    willing
    eager
    thorough
    high-spirited
    aggresive
    extroverted
    amiable
    fearful
    confident
    sympathetic
    impartial
    assertive
    well-disciplined
    generous
    animated
    persistent
    impulsive
    introverted
    forceful
    easygoing
    good-mixer
    refined
    vigorous
    lenient
    captivating
    contented
    demanding
    compliant
    argumentative
    systematic
    cooperative
    light-hearted
    jovial
    precise
    direct
    even-tempered
    restless
    neighborly
    appealing
    careful
    respectful
    pioneering
    optimistic
    helpful
    ))

(defparameter *answers* nil)

(defun get-random-question ( &optional (q *questions*))
  (nth (random (length q)) q)
  )

(defun get-question-not-already-asked ( &optional (q *questions*) (a *answers*) )
  (if (equal (length *questions*) (length *answers*)) nil
  (let ((the-question (get-random-question q)))
    (if (find the-question a :key #'car) 
        (get-question-not-already-asked q a)
      the-question
      ))))
    
    
(defun test-questions () (push (cons (get-question-not-already-asked) (random 1)) *answers*))    
                            


(publish :path "/survey"
    :content-type "text/html"
    :function
         (let (
               ; (count 0)
            )
           #'(lambda (req ent)
               (let* (
                      ( q (rrequest "question" req) )
                      ( x (when q (magic (format nil "'~a" q))))
		     )
                 
                 (push x *answers*)
               
7          (with-http-response (req ent)
            (with-http-body (req ent)
              (html
                (:html
                  (:head (:title "SURVEY"))
                 (:body "Survey:  answer the following questions:"
		 ; (princ-safe "Gayatri = Rani[Blossom]") 

                        ((:form :action "survey")
                         
                         (ask-survey-question "enthusiastic")
;;;                         "enthusiastic"
;;;                         ( (:input type "radio" name "enthusiastic" value "1") "yes")
;;;                         ( (:input type "radio" name "enthusiastic" value "0") "no")
                         :hr
                         (submit-button)
                         
                   ) ; end form
                        :hr
                        (:princ-safe q) :p
                         (:princ-safe x)

                        
                        )))))))))



(publish :path "/home"
    :content-type "text/html"
    :function
         (let (
               ; (count 0)
            )
           #'(lambda (req ent)
               (let* (
                     ; ( c (int-request "m-criticality" req) )
                     ; ( f (int-request "m-frequency" req) )
                     ; ( v (int-request "m-visibility" req) )
                     ; ( l (int-request "m-legacy" req) )
                     ; ( x (int-request "m-complexity" req) )
                     ; ( s (int-request "m-scope" req) )
                     ; ( the-rpn (+ c f l v s x))
		     )

               
          (with-http-response (req ent)
            (with-http-body (req ent)
              (html
                (:html
                  (:head (:title "HOME"))
                 (:body "aum namah shivay"
                        ; (princ-safe "Gayatri = Rani[Blossom]") 
                        (generic-link "tip" "Tip Calculator") :p
                        (generic-link "eval" "Lisp Evaluation") :p
                        (generic-link "survey" "Personality Inventory Survey") :p
                                     

                        ((:form :action "rpn-01")
                         (submit-button)
                         
                   ) ; end form
                        (html :hr)

                        
                        )))))))))

(defun magic (str)
  (when (and str (> (length str) 0))
  (with-input-from-string (in str)
    (eval (read in)))))


(defun do-process-expression (ex use-parens)
  (let* (
         ( n-lparen (count #\( ex) )
         ( n-rparen (count #\) ex) )
         )
    (if (equal n-lparen n-rparen) 
        (if use-parens 
            (format nil "( ~a )" ex) 
          ex
          )
      (format nil "'(unbalanced parenthesis ( ~a ~a ))" n-lparen n-rparen)
      )))
        

(defun conditional-concatenation (x y) 
  (if (x) (format nil "~a ~a" x y) y))

(defun nice-option (the-name &optional the-value)
  (if the-value
      (html ( (:option :value the-value) (:princ-safe the-name)))
    (html (:option (:princ-safe the-name)))
    ))



; assumes id < name in the-options-with-values 
(defun nice-list-box-with-values (the-name the-options-with-values )
  (html ((:select :name the-name)
         
         (mapcar #'(lambda (it) (nice-option (cadr it) (car it))) the-options-with-values)
         ; (mapcar #'nice-option the-options)
         )))

         
(defparameter *some-functions*
  '( "nil" "setf" "*" "+" "-" "/" "log" "expt"))

(defun get-function-list (&optional (l *some-functions*) )
  (mapcar #'(lambda (it) (list it it)) l))

(publish :path "/eval"
    :content-type "text/html"
    :function
         (let (
               ; (count 0)
            )
           #'(lambda (req ent)
               (let* (
                      ( the-expression- (rrequest "eval-this" req) )
                      ( use-parens (rrequest "parens" req ) )
                      ; ( do-prime (rrequest "prime" req))
                      ( the-function (rrequest "function" req))
                      ( the-expression (if (equal "nil" the-function) the-expression- (format nil "~a ~a" the-function the-expression-) ))
                      ( the-result (magic (do-process-expression the-expression use-parens)))
                      )
          (with-http-response (req ent)
            (with-http-body (req ent)
              (html
                (:html
                  (:head (:title "EVAL"))
                 (:body "Enter a lisp expression for evaluation:" :p
                        (:princ-safe "result = ")
                        (:princ-safe the-result) :p
                        ; (:princ-safe the-expression )
                        ((:form :action "eval")
                        (submit-button) :p
                         ( (:input name "eval-this" value the-expression) ) :p
                         (ask-checkbox "parens" "true" (if use-parens t nil)) :p
                         ; (ask-checkbox "prime" "true" nil ) :p
                         (nice-list-box-with-values "function" '( ("nil" "nil") ("setf" "setf") ("*" "*") ("+" "+") ("expt" "expt")))
                         ; (:princ-safe use-parens)
                   ) ; end form
                        (html :hr)
                        )))))))))



;;;(defun tip (n)
;;;  (multiple-value-bind (dollars cents) (floor (* 1.15 n))
;;;    (list (* 1.15 n) (1+ dollars) (- (1+ dollars) n))))

(defun pennies-only (x) (/ (round (* x 100.0)) 100.0))    

(defun convention-nil-is-zero (n &optional (d 0) ) (if n n d))


(defun tips (original-amount- &optional (percentage- 0.15))
  (let* 
      ( 
       (original-amount (if original-amount- original-amount- 0))
       (percentage (if percentage- percentage- 0))
       (nominal-total (* (+ 1 percentage) original-amount))
       (floor-of-nominal-total (floor nominal-total))
       ; (nominal-tip (* percentage original-amount))
       )
    (multiple-value-bind (dollars cents) floor-of-nominal-total
    (let* ( 
           (new-total (1+ dollars) )
           (new-tip-amount (- new-total original-amount))
          )
      (mapcar #'pennies-only (list nominal-total new-total new-tip-amount (convention-nil-is-zero cents)) )
      ; (list nominal-total new-total new-tip-amount (convention-nil-is-zero cents))
      ))))
    

(defmacro some-line (a b) `(:html (:princ-safe ,a) (:princ-safe ,b) :p))


(publish :path "/tip"
    :content-type "text/html"
    :function
         (let (
               ; (count 0)
            )
           #'(lambda (req ent)
               (let* (
                      ( the-raw-tip- (rrequest "tip" req) )
                      ( the-raw-tip  (if the-raw-tip- the-raw-tip- "0"))
                      ( the-tip-percentage-  (rrequest "tip-percentage" req))
                      ( the-tip-percentage  (if the-tip-percentage- the-tip-percentage- "0.15"))
                      
                      ( the-result (tips (magic the-raw-tip) (magic the-tip-percentage)) )
                      )
          (with-http-response (req ent)
            (with-http-body (req ent)
              (html
                (:html
                  (:head (:title "TIP"))
                 (:body "Enter the value of the bill" :p
;;;                        (some-line "the-raw-tip = " the-raw-tip)
;;;                        (some-line "the-tip-percentage = " the-tip-percentage)
;;;                        (some-line "the-result = " the-result)
;;;                        (:princ-safe "raw tip = " ) 
;;;                        (:princ-safe (car the-result)) :p
;;;                        (:princ-safe "rounded up to the nearest $ ")
;;;                        (:princ-safe (cadr the-result)) :p
;;;                        (:princ-safe "meaning tip amount is ")
;;;                        (:princ-safe (caddr the-result)) :p
                        :p
                        ((:form :action "tip")
                          ( (:input name "tip" value the-raw-tip) " - bill" ) :p
                          ( (:input name "tip-percentage" value the-tip-percentage) " - %") :p
                        (submit-button)
                   ) ; end form
                        (html :hr)
                        (some-line "raw tip       = " (car the-result))
                        (some-line "round to next $ " (cadr the-result))
                        (some-line "tip amount    = " (caddr the-result))
                        :hr
                        
                        )))))))))



(publish :path "/tip-old"
    :content-type "text/html"
    :function
         (let (
               ; (count 0)
            )
           #'(lambda (req ent)
               (let* (
                      ( the-raw-tip- (rrequest "tip" req) )
                      ( the-raw-tip (if the-raw-tip- the-raw-tip- "0"))
                      ( the-tip-percentage- (rrequest "tip-percentage" req))
                      ( the-tip-percentage (if the-tip-percentage- the-tip-percentage- "0.15"))
                      
                      ( the-result (tips (magic the-raw-tip) (magic the-tip-percentage)) )
                      )
          (with-http-response (req ent)
            (with-http-body (req ent)
              (html
                (:html
                  (:head (:title "TIP"))
                 (:body "Enter the value of the bill" :p
;;;                        (some-line "the-raw-tip = " the-raw-tip)
;;;                        (some-line "the-tip-percentage = " the-tip-percentage)
;;;                        (some-line "the-result = " the-result)
;;;                        (:princ-safe "raw tip = " ) 
;;;                        (:princ-safe (car the-result)) :p
;;;                        (:princ-safe "rounded up to the nearest $ ")
;;;                        (:princ-safe (cadr the-result)) :p
;;;                        (:princ-safe "meaning tip amount is ")
;;;                        (:princ-safe (caddr the-result)) :p
                        :p
                        ((:form :action "tip")
                         ( (:input name "tip" value the-raw-tip) " - bill" ) :p
                         ( (:input name "tip-percentage" value the-tip-percentage) " - %") :p
                        (submit-button)
                   ) ; end form
                        (html :hr)
                        (some-line "raw tip       = " (car the-result))
                        (some-line "round to next $ " (cadr the-result))
                        (some-line "tip amount    = " (caddr the-result))
                        :hr
                        
                        )))))))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




(defun start-remote ()
  (setf *agc* (db.agraph.client:make-allegrograph-connection :host "50.16.101.220" :port 4567) )
  (db.agraph.client:enable-connection *agc*)
  (setf *ts* (db.agraph.user::create-triple-store  
               "gujarat-01"  
               :connection *agc*  
            :triple-store-class 'db.agraph.user::remote-triple-store
              :if-exists :supersede            )) 
  ; (net.aserve:start :port 8000)
  
  ; todo:  load the ontology and index the triples.
  ; (gen-res::commit-universe)

  )

(defmacro cube (n) (* n n n))




